home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / a_utils / ffccflow / ffccflow.lha / ffccc+flow / ffccc / DEFSTA.f < prev    next >
Encoding:
Text File  |  1992-07-31  |  4.7 KB  |  106 lines
  1.       SUBROUTINE DEFSTA(INDE,ILEN,CNAM,FOK) 
  2. C For statement class INDE returns length of FORTRAN
  3. C keyword (ILEN), keyword name (CNAM*25) and logical
  4. C FOK, which is set if the statement is to be checked   
  5. C for embedded blanks.  
  6. C INPUT ; INDE  
  7. C OUTPUT; ILEN  
  8. C         CNAM  
  9. C         FOK   
  10. C   
  11.       include 'PARAM.h' 
  12.       include 'USUNIT.h' 
  13.       CHARACTER*25 CNAM 
  14.       LOGICAL FOK   
  15.       PARAMETER (LFOK=37)   
  16.       DIMENSION IFOK(LFOK)  
  17.       CHARACTER CFORTS(MXSTAT)*25   
  18.       DATA CFORTS(  1)/'ASSIGN                   '/ 
  19.       DATA CFORTS(  2)/'BACKSPACE                '/ 
  20.       DATA CFORTS(  3)/'BLOCKDATA                '/ 
  21.       DATA CFORTS(  4)/'BUFFERIN                 '/ 
  22.       DATA CFORTS(  5)/'BUFFEROUT                '/ 
  23.       DATA CFORTS(  6)/'CONTINUE                 '/ 
  24.       DATA CFORTS(  7)/'CALL                     '/ 
  25.       DATA CFORTS(  8)/'COMMON                   '/ 
  26.       DATA CFORTS(  9)/'COMPLEXFUNCTION          '/ 
  27.       DATA CFORTS( 10)/'COMPLEX                  '/ 
  28.       DATA CFORTS( 11)/'COMPLEX                  '/ 
  29.       DATA CFORTS( 12)/'CHARACTERFUNCTION        '/ 
  30.       DATA CFORTS( 13)/'CHARACTER                '/ 
  31.       DATA CFORTS( 14)/'CHARACTER                '/ 
  32.       DATA CFORTS( 15)/'CLOSE                    '/ 
  33.       DATA CFORTS( 16)/'DATA                     '/ 
  34.       DATA CFORTS( 17)/'DIMENSION                '/ 
  35.       DATA CFORTS( 18)/'DO                       '/ 
  36.       DATA CFORTS( 19)/'DO                       '/ 
  37.       DATA CFORTS( 20)/'DECODE                   '/ 
  38.       DATA CFORTS( 21)/'DOUBLEPRECISIONFUNCTION  '/ 
  39.       DATA CFORTS( 22)/'DOUBLEPRECISION          '/ 
  40.       DATA CFORTS( 23)/'END                      '/ 
  41.       DATA CFORTS( 24)/'ENDIF                    '/ 
  42.       DATA CFORTS( 25)/'ENDFILE                  '/ 
  43.       DATA CFORTS( 26)/'ENTRY                    '/ 
  44.       DATA CFORTS( 27)/'EQUIVALENCE              '/ 
  45.       DATA CFORTS( 28)/'EXTERNAL                 '/ 
  46.       DATA CFORTS( 29)/'ELSE                     '/ 
  47.       DATA CFORTS( 30)/'ELSEIF                   '/ 
  48.       DATA CFORTS( 31)/'ENCODE                   '/ 
  49.       DATA CFORTS( 32)/'FORMAT                   '/ 
  50.       DATA CFORTS( 33)/'FUNCTION                 '/ 
  51.       DATA CFORTS( 34)/'GOTO                     '/ 
  52.       DATA CFORTS( 35)/'GOTO                     '/ 
  53.       DATA CFORTS( 36)/'GOTO                     '/ 
  54.       DATA CFORTS( 37)/'IF                       '/ 
  55.       DATA CFORTS( 38)/'IF                       '/ 
  56.       DATA CFORTS( 39)/'IF                       '/ 
  57.       DATA CFORTS( 40)/'ILLEGAL                  '/ 
  58.       DATA CFORTS( 41)/'INTEGERFUNCTION          '/ 
  59.       DATA CFORTS( 42)/'INTEGER                  '/ 
  60.       DATA CFORTS( 43)/'INTEGER                  '/ 
  61.       DATA CFORTS( 44)/'IMPLICIT                 '/ 
  62.       DATA CFORTS( 45)/'INQUIRE                  '/ 
  63.       DATA CFORTS( 46)/'INTRINSIC                '/ 
  64.       DATA CFORTS( 47)/'LOGICALFUNCTION          '/ 
  65.       DATA CFORTS( 48)/'LOGICAL                  '/ 
  66.       DATA CFORTS( 49)/'LOGICAL                  '/ 
  67.       DATA CFORTS( 50)/'LEVEL                    '/ 
  68.       DATA CFORTS( 51)/'NAMELIST                 '/ 
  69.       DATA CFORTS( 52)/'OPEN                     '/ 
  70.       DATA CFORTS( 53)/'PRINT                    '/ 
  71.       DATA CFORTS( 54)/'PARAMETER                '/ 
  72.       DATA CFORTS( 55)/'PAUSE                    '/ 
  73.       DATA CFORTS( 56)/'PROGRAM                  '/ 
  74.       DATA CFORTS( 57)/'PUNCH                    '/ 
  75.       DATA CFORTS( 58)/'READ                     '/ 
  76.       DATA CFORTS( 59)/'READ                     '/ 
  77.       DATA CFORTS( 60)/'REALFUNCTION             '/ 
  78.       DATA CFORTS( 61)/'REAL                     '/ 
  79.       DATA CFORTS( 62)/'REAL                     '/ 
  80.       DATA CFORTS( 63)/'RETURN                   '/ 
  81.       DATA CFORTS( 64)/'REWIND                   '/ 
  82.       DATA CFORTS( 65)/'SAVE                     '/ 
  83.       DATA CFORTS( 66)/'STOP                     '/ 
  84.       DATA CFORTS( 67)/'SUBROUTINE               '/ 
  85.       DATA CFORTS( 68)/'WRITE                    '/ 
  86.       DATA CFORTS( 69)/'ASSIGNMENT               '/ 
  87.       DATA CFORTS( 70)/'ASSIGNMENT               '/ 
  88.       DATA CFORTS( 71)/'ASSIGNMENT               '/ 
  89. C   
  90.       DATA IFOK /13,31,32,42,48,52,53,54,57,58,59,61, 68,69,70,71,30,34,
  91.      +35,36,37,38,39,8,9,12,21,22,24,41,47,60,14,43,49,62,11/   
  92.       FOK = .FALSE. 
  93.       IF(INDE.GT.MXSTAT.OR.INDE.LT.1) THEN  
  94.          WRITE(MZUNIT,500)  
  95.          RETURN 
  96.       ENDIF 
  97.       DO 10 I=1,LFOK
  98.          IF(INDE.EQ.IFOK(I)) RETURN 
  99.    10 CONTINUE  
  100.       FOK = .TRUE.  
  101.       CNAM = CFORTS(INDE)   
  102.       ILEN = INDEX(CNAM,' ')-1  
  103.       RETURN
  104.   500 FORMAT(1X,'!!! NON-FATAL ERROR IN DEFSTA')
  105.       END   
  106.